home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d19 / cal14s6.arc / BUFIO.PAS next >
Pascal/Delphi Source File  |  1988-12-31  |  9KB  |  287 lines
  1.  
  2. (*
  3.  * Bufio - Buffered File I/O Unit
  4.  *
  5.  * (C) 1988 Samuel H. Smith,  (rev 24-May-88)
  6.  *
  7.  * This unit provides both read and write buffering on block oriented
  8.  * random-access files.  It is optimized for sequential reads or writes,
  9.  * but will function properly with fully random files.
  10.  *
  11.  *)
  12.  
  13. {$i prodef.inc}
  14.  
  15. unit BufIO;
  16.  
  17. interface
  18.    uses DosMem, MdosIO;
  19.  
  20.    const
  21.       maxbufsiz = $FE00;         {largest file buffer to allocate}
  22.  
  23.    type
  24.       bufarray = array[0..maxbufsiz] of char;
  25.  
  26.       buffered_file = record     {buffered file description record}
  27.          pathname:   dos_filename;  {full name of the file}
  28.          handle:     dos_handle; {handle for dos calls}
  29.          maxrec:     word;       {maximum number of records}
  30.          recsiz:     word;       {record size}
  31.          bufsiz:     word;       {size of the data buffer}
  32.          buffer:     ^bufarray;  {the data buffer}
  33.          fptr:       word;       {base record in file for buffer}
  34.          fnext:      word;       {next record position in buffer (0=first)}
  35.          fcount:     word;       {count of records in buffer}
  36.          dirty:      boolean;    {unsaved changes in buffer?}
  37.       end;
  38.  
  39.  
  40.    var
  41.       berr: boolean;       {true if buffered read or write fails}
  42.  
  43.  
  44.    procedure bcreate(name:    dos_filename);
  45.       {create an empty file; use with bopen to open output files}
  46.  
  47.    procedure bopen(var bfd:   buffered_file;
  48.                    name:      dos_filename;
  49.                    maxrecn:   word;
  50.                    recsize:   word);
  51.       {open a buffered file}
  52.  
  53.    procedure bflush(var bfd:  buffered_file);
  54.       {write buffer, force re-read on next access}
  55.       
  56.    procedure bseek(var bfd:   buffered_file;
  57.                    recn:      word);
  58.       {set position of buffered file}
  59.    
  60.    procedure bseekeof(var bfd:   buffered_file);
  61.       {set position of buffered file to end-of-file}
  62.    
  63.    function btell(var bfd:    buffered_file): word;
  64.       {tell current record number in buffered file}
  65.  
  66.    function beof(var bfd:     buffered_file): boolean;
  67.       {check for eof on buffered file}
  68.  
  69.    procedure bread(var bfd:   buffered_file;
  70.                    var dest);
  71.       {buffered read}
  72.    
  73.    procedure bwrite(var bfd:   buffered_file;
  74.                     var src);
  75.       {buffered write}
  76.  
  77.    procedure bclose(var bfd:  buffered_file);
  78.       {close a buffered file}
  79.  
  80.  
  81.  
  82. implementation
  83.  
  84. (* -------------------------------------------------------- *)
  85.    procedure bcreate(name:    dos_filename);
  86.       {create an empty file}
  87.    begin
  88.       dos_close(dos_create(name));
  89.    end;
  90.  
  91.  
  92. (* -------------------------------------------------------- *)
  93.    procedure bopen(var bfd:   buffered_file;
  94.                    name:      dos_filename;
  95.                    maxrecn:   word;
  96.                    recsize:   word);
  97.       {open a buffered file}
  98.    var
  99.       limrec:  word;
  100.    begin
  101.       {reduce buffer records if needed to avoid exceeding buffer size limit}
  102.       limrec := maxbufsiz div recsize;
  103.       if maxrecn > limrec then
  104.          maxrecn := limrec;
  105.  
  106.       {initialize the file buffer variables}
  107.       bfd.maxrec := maxrecn;
  108.       bfd.recsiz := recsize;
  109.       bfd.bufsiz := maxrecn*recsize;
  110.       bfd.fcount := 0;
  111.       bfd.fnext := 0;
  112.       bfd.fptr := 0;
  113.       bfd.dirty := false;
  114.       bfd.pathname := name;
  115.  
  116.       {open the file and allocate a buffer for it}
  117.       bfd.handle := dos_open(name, open_update);
  118.       berr := bfd.handle = dos_error;
  119.       if berr then
  120.          bfd.buffer := nil
  121.       else
  122.          dos_getmem(bfd.buffer, bfd.bufsiz);
  123.  
  124. (****
  125.    writeln('bopen: handle=',bfd.handle,
  126.                   ' path=',bfd.pathname,
  127.                   ' buf@',seg(bfd.buffer^),':',ofs(bfd.buffer^),
  128.                   ' bfd@',seg(bfd),':',ofs(bfd));
  129.  *****)
  130.    end;
  131.  
  132.  
  133. (* -------------------------------------------------------- *)
  134.    procedure bflush(var bfd:  buffered_file);
  135.       {save changes in buffer, force re-read on next access}
  136.    begin
  137.       {if file has been written, write buffer contents}
  138.       if bfd.dirty then
  139.       begin
  140.          dos_rseek(bfd.handle, bfd.fptr, bfd.recsiz, seek_start);
  141.          dos_write(bfd.handle, bfd.buffer^, bfd.recsiz*bfd.fcount);
  142. {writeln('...write ',bfd.fcount,' fptr=',bfd.fptr,' name=',bfd.pathname);}
  143.          bfd.dirty := false;
  144.          berr := dos_write_failed;
  145.       end
  146.       else
  147.          berr := false;
  148.  
  149.       {adjust physical position in file and empty the buffer}
  150.       inc(bfd.fptr, bfd.fnext);
  151.       bfd.fnext := 0;
  152.       bfd.fcount := 0;
  153.       dos_rseek(bfd.handle, bfd.fptr, bfd.recsiz, seek_start);
  154.    end;
  155.  
  156.  
  157. (* -------------------------------------------------------- *)
  158.    procedure bseek(var bfd:   buffered_file;
  159.                    recn:      word);
  160.       {set position of buffered file}
  161.    begin
  162.       {reposition within buffer, if possible}
  163.       if (recn >= bfd.fptr) and (recn <= bfd.fptr+bfd.fcount) then
  164.          bfd.fnext := recn - bfd.fptr
  165.       else
  166.       begin
  167.          {save changes, if any}
  168.          if bfd.dirty then
  169.             bflush(bfd);
  170.  
  171.          {perform the physical seek}
  172.          bfd.fptr := recn;
  173.          bfd.fnext := 0;
  174.          bfd.fcount := 0;
  175.          dos_rseek(bfd.handle, recn, bfd.recsiz, seek_start);
  176.       end;
  177.    end;
  178.    
  179.  
  180. (* -------------------------------------------------------- *)
  181.    procedure bseekeof(var bfd:   buffered_file);
  182.       {set position of buffered file to end-of-file}
  183.    begin
  184.       {save changes, if any}
  185.       if bfd.dirty then
  186.          bflush(bfd);
  187.  
  188.       dos_lseek(bfd.handle, 0, seek_end);
  189.       bfd.fptr := dos_tell div longint(bfd.recsiz);
  190.       bfd.fnext := 0;
  191.       bfd.fcount := 0;
  192.    end;
  193.    
  194.  
  195. (* -------------------------------------------------------- *)
  196.    function btell(var bfd:    buffered_file): word;
  197.       {tell current record number in buffered file}
  198.    begin
  199.       btell := bfd.fptr+bfd.fnext;
  200.    end;
  201.  
  202.  
  203. (* -------------------------------------------------------- *)
  204.    function beof(var bfd: buffered_file): boolean;
  205.       {check for eof on buffered file}
  206.    begin
  207.       {read next block if buffer is empty or exhausted}
  208.       if bfd.fnext >= bfd.fcount then
  209.       begin
  210.          {save changes if buffer has been written}
  211.          if bfd.dirty then
  212.             bflush(bfd);
  213.  
  214.          inc(bfd.fptr,bfd.fcount);
  215.          bfd.fnext := 0;
  216.          bfd.fcount :=
  217.                dos_read(bfd.handle, bfd.buffer^, bfd.bufsiz) div bfd.recsiz;
  218. {writeln('...read ',bfd.fcount,' fptr=',bfd.fptr,' name=',bfd.pathname);}
  219.       end;
  220.       
  221.       {eof if no records left}
  222.       beof := bfd.fcount = 0;
  223.    end;
  224.          
  225.  
  226. (* -------------------------------------------------------- *)
  227.    procedure bread(var bfd:   buffered_file;
  228.                    var dest);
  229.       {buffered read}
  230.    begin
  231.       {check for end of file; read next block when needed}
  232.       berr := beof(bfd);
  233.       if berr then
  234.          exit;
  235.  
  236.       {copy from buffer to user variable}
  237.       move(bfd.buffer^[bfd.fnext*bfd.recsiz], dest, bfd.recsiz);
  238.       inc(bfd.fnext);
  239.    end;
  240.    
  241.  
  242. (* -------------------------------------------------------- *)
  243.    procedure bwrite(var bfd:   buffered_file;
  244.                     var src);
  245.       {buffered write (call dos_write_failed to check status)}
  246.    begin
  247.       {save changes if not yet writing or if buffer is full of changes}
  248.       if (not bfd.dirty) or (bfd.fnext >= bfd.maxrec) then
  249.          bflush(bfd)
  250.       else
  251.          berr := false;
  252.  
  253.       {save user variable in buffer and flag it as 'dirty'(unsaved)}
  254.       move(src, bfd.buffer^[bfd.fnext*bfd.recsiz], bfd.recsiz);
  255.       inc(bfd.fnext);
  256.       if bfd.fcount < bfd.fnext then
  257.          inc(bfd.fcount);
  258.       bfd.dirty := true;
  259.    end;
  260.  
  261.  
  262. (* -------------------------------------------------------- *)
  263.    procedure bclose(var bfd:  buffered_file);
  264.       {close a buffered file}
  265.    begin
  266.       if bfd.buffer = nil then
  267.          exit;
  268.  
  269.       bflush(bfd);
  270.       dos_close(bfd.handle);              {low-level file close}
  271.  
  272. (****
  273.     writeln('bclose: handle=',bfd.handle,
  274.                   ' path=',bfd.pathname,
  275.                   ' buf@',seg(bfd.buffer^),':',ofs(bfd.buffer^),
  276.                   ' bfd@',seg(bfd),':',ofs(bfd));
  277.  ****)
  278.  
  279.       dos_freemem(bfd.buffer);    {release buffer memory}
  280.    end;
  281.  
  282.  
  283. {unit initialization}
  284. {begin}
  285. end.
  286.  
  287.